home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / ODE / ajf_base next >
Encoding:
Text File  |  1991-06-05  |  3.0 KB  |  126 lines
  1. \ Common Host dependant FORTH words.
  2. \
  3. \ This file is used to enhance the portability of code between
  4. \ different Forths.  A large application that has been ported
  5. \ between 7 different Forth environments was examined.  Any simple
  6. \ words that seemed to be Host or Forth dependant were put in
  7. \ this file. 
  8. \
  9. \ This file was originally part of HMSL.
  10. \ HMSL is a music language written by Phil Burk,
  11. \ Larry Polansky, and David Rosenboom at Mill's college CCM.
  12. \ The Object Development Environment , graphics language, ajf_base,
  13. \ and utils are part of that system.
  14. \ Constants are set in this file that control conditional
  15. \ compilation in other files.
  16. \ This is so that the same source code can be used with several
  17. \ different Forths.  If you are supporting more than one machine
  18. \ with your code, you may want to use a technique similar to this.
  19. \ HMSL also runs on the Macintosh under MACH2, another
  20. \ excellent Forth.
  21. \
  22. \ These are the definitions required for HMSL using
  23. \ JForth on the Amiga.
  24. \
  25. \ Some related files are ajf_dict , ajf_debug
  26. \
  27. \ Author: Phil Burk
  28. \ Copyright 1986 Delta Research
  29. \
  30. \ MOD: PLB 1/29/88 Add CFA->NFA
  31. \ MOD: PLB 2/19/89 Add flushemit to BELL
  32. \ MOD: PLB 8/31/89 Add IF.REL->USE
  33. \ MOD: PLB 4/26/91 Make CELL* BOTH
  34. \ MOD: PLB 6/5/91 Add ?QUIT, moved from MISC_TOOLS
  35.  
  36. ANEW TASK-AJF_BASE
  37. decimal
  38.  
  39. : H. ( num -- , print a number in HEX )
  40.     base @ swap hex . base !
  41. ;
  42.  
  43. : V: ( -- , declare variable and set to zero )
  44.     variable
  45. ;
  46.  
  47. : BELL  ( -- , ring bell or flash screen )
  48.     7 emit flushemit
  49. ;
  50.  
  51. \ Used for relocation of addresses between snapshots.
  52. \ These words are needed for Forths that use absolute addressing.
  53. : REL->USE  ( REL_address -- USEABLE_address )
  54. ; immediate
  55. : USE->REL  ( USEABLE_address -- REL_address )
  56. ; immediate
  57.  
  58. : IF.REL->USE  ( REL_address -- USEABLE_address )
  59. ; immediate
  60. : IF.USE->REL  ( USEABLE_address -- REL_address )
  61. ; immediate
  62.  
  63. : USE->ABS
  64.    >abs
  65. ;
  66. : ABS->USE
  67.    >rel
  68. ;
  69.  
  70. -1 -1 shift constant HO_MAX_INT
  71. HO_MAX_INT 1+ CONSTANT HO_MIN_INT
  72.  
  73. V: TAB-WIDTH  8 TAB-WIDTH !
  74. : TAB  ( -- , tab over to next stop )
  75.     space out @ tab-width @ mod
  76.     tab-width @   swap - spaces
  77. ;
  78.  
  79.  
  80. : CELL*  ( n -- n*cell , useful for indexing into tables )
  81.     cells
  82.     both
  83. ;
  84.  
  85. : VALLOT ( #bytes -- , allot space in VARIABLE area )
  86.     allot   ( in dictionary for JFORTH )
  87. ;
  88.  
  89. \ FORTH83 uses a different system for PICK !!!
  90. \ JForth conforms to Forth83, -> PICK is 0 based.
  91. : PICK83 PICK ;
  92. : PICK79 1- PICK ;
  93.  
  94. : HOST"  ( <text>" -- , compile a host string )
  95.     [compile] 0"  ( Amiga 'C' library NUL terminated string.)
  96. ; immediate
  97.  
  98. \ Fast Math
  99. \ These operate directly on TOS which is cached in D7
  100. HEX
  101. : 4+ [ 5887 w, ] inline ; ( ADDQ.L #4,D7 )
  102. : 4- [ 5987 w, ] inline ;
  103. : 4/ [ E487 w, ] inline ;
  104. : 4* [ E587 w, ] inline ;
  105. DECIMAL
  106.  
  107. \ Some systems have difficult USER variables.
  108. : U:  ( -- , Make a USER variable, automatically allocated )
  109.     USER
  110. ;
  111.  
  112. \ Dictionary conversion support.
  113. : CFA->NFA ( cfa -- nfa )
  114.     >name
  115. ;
  116.  
  117. false constant #HOST_MAC_H4TH
  118.  
  119. .NEED ?QUIT
  120. : ?QUIT ( -- flag , Pause, true if 'q' )
  121.     ." Hit any key to continue, 'q' to quit:"
  122.     key cr ascii q =
  123. ;
  124. .THEN
  125.  
  126.